home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / EDITUSR1.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  15KB  |  448 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  7-18-88 11:54 am 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit EditUsr1;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, TAccess, Core1,
  19.   Core2, TPSTRING, MsgMisc;
  20.   
  21.   
  22. procedure edit_user(fn : FirstName; ln : LastName; credits : Word);
  23.  
  24.  
  25.   {==========================================================================}
  26.   
  27.   
  28. Implementation
  29.  
  30.  
  31.   procedure change_user_params_A(num : Integer; var temp_user_rec : user_list);
  32.   
  33.   var
  34.     temp, i         : Integer;
  35.     Str             : StrStd;
  36.     
  37.   begin
  38.     with temp_user_rec do
  39.       begin
  40.         case num of
  41.           1 :
  42.             begin
  43.               Str := prompt('Computer ', len_ad, 'EL');
  44.               if Str <> '' then
  45.                 ad := Str;
  46.             end;
  47.           2 :
  48.             begin
  49.               Str := prompt('City ', len_cy, 'EL');
  50.               if Str <> '' then
  51.                 cy := Str;
  52.             end;
  53.           3 :
  54.             begin
  55.               Str := prompt('State (2 ltrs.) ', len_st, 'ESL');
  56.               if Str <> '' then
  57.                 st := Str;
  58.             end;
  59.           4 :
  60.             begin
  61.               Str := prompt('Phone number ', len_ph, 'EL');
  62.               if Str <> '' then
  63.                 ph := Str;
  64.             end;
  65.           5 :
  66.             begin
  67.               Str := prompt('Password ', len_pw, 'ESL');
  68.               if Str <> '' then
  69.                 pw := Str;
  70.             end;
  71.           6 :
  72.             begin
  73.               Str := prompt('Access Level ', 3, 'EL');
  74.               if Str <> '' then
  75.                 begin
  76.                   temp := strint(Str);
  77.                   if (temp <= user_rec.access) or (not remote_copy) then
  78.                     access := temp
  79.                 end;
  80.             end;
  81.           7 :
  82.             begin
  83.               Str := prompt('Time Limit (min.) ', 3, 'EL');
  84.               if Str <> '' then
  85.                 limit := strint(Str);
  86.             end;
  87.           8 :
  88.             begin
  89.               Str := prompt('Nulls ', 1, 'EL');
  90.               if Str <> '' then
  91.                 nulls := strint(Str);
  92.             end;
  93.           9 :
  94.             begin
  95.               Str := prompt('Case (U/L) ', 1, 'ESL');
  96.               if Str <> '' then
  97.                 shift_lock := (Str = 'U');
  98.             end;
  99.           10 :
  100.             begin
  101.               Str := prompt('Noisy (Y/N) ', 1, 'ESL');
  102.               if Str <> '' then
  103.                 noisy := (Str = 'Y');
  104.             end;
  105.           11 :
  106.             begin
  107.               Str := prompt('Conferences 1-7 [enter consecutive #s: 0=none] ', 7, 'ESL');
  108.               if Str <> '' then
  109.                 begin
  110.                   clear_bit(conf_flags, 0); {don't use this bit}
  111.                   for i := 1 to 7 do
  112.                     if Pos(Chr(i+48), Str) > 0 then
  113.                       set_bit(conf_flags, i)
  114.                     else
  115.                       clear_bit(conf_flags, i);
  116.                   if Str = '0' then
  117.                     conf_flags := 0;
  118.                 end;
  119.             end;
  120.           12 :
  121.             begin
  122.               Str := prompt('Width (columns) ', 2, 'ESL');
  123.               if Str <> '' then
  124.                 columns := strint(Str);
  125.             end;
  126.         end;                      {case}
  127.       end;
  128.       
  129.   end;
  130.   
  131.   
  132.   
  133.   procedure change_user_params_B(num : Integer; var temp_user_rec : user_list);
  134.   
  135.   var
  136.     Str             : StrStd;
  137.     
  138.   begin
  139.     with temp_user_rec do
  140.       begin
  141.         case num of
  142.           13 :
  143.             begin
  144.               Str := prompt('Lines per screen ', 2, 'ESL');
  145.               if Str <> '' then
  146.                 lines := strint(Str);
  147.             end;
  148.           14 :
  149.             begin
  150.               Str := prompt('On Today ', 5, 'EL');
  151.               if Str <> '' then
  152.                 time_today := strint(Str);
  153.             end;
  154.           15 :
  155.             begin
  156.               Str := prompt('On Total  ', 5, 'EL');
  157.               if Str <> '' then
  158.                 time_total := strint(Str);
  159.             end;
  160.           16 :
  161.             begin
  162.               Str := prompt('Last Hi Msg. ', 5, 'EL');
  163.               if Str <> '' then
  164.                 lasthi := strint(Str);
  165.             end;
  166.           17 :
  167.             begin
  168.               Str := prompt('Uploads ', 5, 'EL');
  169.               if Str <> '' then
  170.                 upload := strint(Str);
  171.             end;
  172.           18 :
  173.             begin
  174.               Str := prompt('Downloads ', 5, 'EL');
  175.               if Str <> '' then
  176.                 download := strint(Str)
  177.             end;
  178.           19 :
  179.             if test_bit(Flags, 1) then
  180.               clear_bit(Flags, 1)
  181.             else
  182.               set_bit(Flags, 1);
  183.           20 :
  184.             if test_bit(Flags, 2) then
  185.               clear_bit(Flags, 2)
  186.             else
  187.               set_bit(Flags, 2);
  188.           21 :
  189.             if test_bit(Flags, 3) then
  190.               clear_bit(Flags, 3)
  191.             else
  192.               set_bit(Flags, 3);
  193.           22 :
  194.             if test_bit(Flags, 4) then
  195.               clear_bit(Flags, 4)
  196.             else
  197.               set_bit(Flags, 4);
  198.           23 :
  199.             if test_bit(Flags, 5) then
  200.               clear_bit(Flags, 5)
  201.             else
  202.               set_bit(Flags, 5);
  203.           24 :
  204.             repeat
  205.               Str := Copy(prompt('Protocol ', 1, 'ES'), 1, 1);
  206.               protocol := Str[1];
  207.             until (protocol in ['X', 'C', 'Y', 'B', 'Z', 'G', 'Q', 'O']) or (not Online);
  208.           25 :
  209.             begin
  210.               Str := prompt('Upload/Download ratio [0 = unlimited] ', 3, 'EL');
  211.               if Str <> '' then
  212.                 ratio := strint(Str)
  213.             end;
  214.           26 :
  215.             begin
  216.               Str := prompt('Account Balance [in cents] ', 4, 'EL');
  217.               if Str <> '' then
  218.                 acct_bal := strint(Str)
  219.             end;
  220.             
  221.         end;                      {case}
  222.       end;
  223.   end;
  224.   
  225.   
  226.   
  227.   procedure edit_user(fn : FirstName; ln : LastName; credits : Word);
  228.     { Display and edit user record }
  229.     
  230.   var
  231.     This            : SectPtr;
  232.     this1           : AreaPtr;
  233.     num             : Integer;
  234.     user_num        : LongInt;
  235.     ed_fn           : FirstName;
  236.     ed_ln           : LastName;
  237.     key             : StrName;
  238.     temp_user_rec   : user_list;
  239.     found           : Boolean;
  240.     
  241.     
  242.     procedure display_user;
  243.     
  244.     var
  245.       disp_case,
  246.       disp_nois       : Str3;
  247.       Str             : StrTAD;
  248.       i               : Integer;
  249.       
  250.     begin
  251.       with temp_user_rec do
  252.         begin
  253.           WriteLn(Com);
  254.           WriteLn(Com);
  255.           WriteLn(Com, '   Name      : ', fn, ' ', ln);
  256.           WriteLn(Com, '1  Computer  : ', ad);
  257.           WriteLn(Com, '2  City      : ', cy);
  258.           WriteLn(Com, '3  State     : ', st);
  259.           WriteLn(Com, '4  Phone     : ', ph);
  260.           WriteLn(Com, '5  Password  : ', pw);
  261.           WriteLn(Com, '6  Acc. level: ', access);
  262.           WriteLn(Com, '7  Time Limit: ', limit);
  263.           WriteLn(Com, '8  Nulls     : ', nulls);
  264.           if shift_lock then
  265.             disp_case := 'ON'
  266.           else
  267.             disp_case := 'OFF';
  268.           WriteLn(Com, '9  Shift lock: ', disp_case);
  269.           if noisy then
  270.             disp_nois := 'ON'
  271.           else
  272.             disp_nois := 'OFF';
  273.           WriteLn(Com, '10 Bell      : ', disp_nois);
  274.           Write(Com, '11 Conferences: ');
  275.           found := False;
  276.           for i := 1 to 7 do
  277.             begin
  278.               if test_bit(conf_flags, i) then
  279.                 begin
  280.                   Write(Com, i, ' ');
  281.                   found := True;
  282.                 end;
  283.             end;
  284.           if not found then
  285.             Write(Com, 'None');
  286.           WriteLn(Com);
  287.           Write(Com, '12 Columns   : ', columns:6, ' ':15, '19 Allow downloads: ');
  288.           if test_bit(Flags, 1) then
  289.             WriteLn(Com, ' No')
  290.           else
  291.             WriteLn(Com, 'Yes');
  292.           Write(Com, '13 Lines     : ', lines:6, ' ':15, '20 Allow private msgs: ');
  293.           if test_bit(Flags, 2) then
  294.             WriteLn(Com, ' No')
  295.           else
  296.             WriteLn(Com, 'Yes');
  297.           Str := intstr(laston[4], 2)+'/'+intstr(laston[3], 2)+'/'+intstr(laston[5], 2);
  298.           Write(Com, '   Last on   : ', Str, ' ':13, '21 Allow public msgs: ');
  299.           if test_bit(Flags, 3) then
  300.             WriteLn(Com, ' No')
  301.           else
  302.             WriteLn(Com, 'Yes');
  303.           Write(Com, '14 On today  : ', time_today:6, ' ':15, '22 Allow any msgs: ');
  304.           if test_bit(Flags, 4) then
  305.             WriteLn(Com, ' No')
  306.           else
  307.             WriteLn(Com, 'Yes');
  308.           Write(Com, '15 On total  : ', time_total:6, ' ':15, '23 Exempt User purge: ');
  309.           if test_bit(Flags, 5) then
  310.             WriteLn(Com, 'Yes')
  311.           else
  312.             WriteLn(Com, ' No');
  313.           WriteLn(Com, '16 Last high : ', lasthi:6, ' ':15, '24 Default Protocol: ',
  314.             protocol);
  315.           WriteLn(Com, '17 Uploads   : ', upload:6, ' ':15, '25 Up/Down Ratio allowed: ',
  316.             ratio);
  317.           WriteLn(Com, '18 Downloads : ', download:6, ' ':15, '26 Account balance: ',
  318.             acct_bal);
  319.           WriteLn(Com);
  320.         end;
  321.     end;
  322.     
  323.   begin                           { edit_user }
  324.     OK := True;
  325.     SetSect(HomName);
  326.     if (fn <> '') or (ln <> '') then
  327.       begin
  328.         ed_fn := fn;
  329.         ed_ln := ln;
  330.       end
  331.     else
  332.       begin
  333.         ed_fn := trim(prompt('First Name', len_fn, 'ESN'));
  334.         if ed_fn = 'SYSOP' then
  335.           ed_ln := ''
  336.         else if ed_fn <> '' then
  337.           ed_ln := trim(prompt('Last Name', len_ln, 'ESN'));
  338.       end;
  339.     if ((ed_fn = '') or (ed_ln = '')) and (ed_fn <> 'SYSOP') then
  340.       OK := False;
  341.     if OK then
  342.       begin
  343.         key := pad(ed_ln, len_ln)+pad(ed_fn, len_fn);
  344.         SearchKey(IdxF, user_num, key);
  345.       end;
  346.     if OK then
  347.       begin
  348.         if user_num = user_loc then
  349.           temp_user_rec := user_rec
  350.         else
  351.           GetRec(DatF, user_num, temp_user_rec);
  352.         if ((temp_user_rec.access <= user_rec.access) or (not remote_copy))
  353.         and (credits = 0) then
  354.           { Only edit users <= self }
  355.           begin
  356.             repeat
  357.               display_user;
  358.               num := strint(prompt('Number to change..[ 0 to abort, 99 to record] ', 2, 'EL')
  359.                 );
  360.               if (num <> 0) and (num <> 99) then
  361.                 begin
  362.                   if num = 11 then
  363.                     begin
  364.                       found := False;
  365.                       WriteLn(Com, 'Message Conferences:');
  366.                       this1 := AreaBase;
  367.                       while this1 <> nil do
  368.                         begin
  369.                           this1^.AreaConf := this1^.AreaConf and 7;
  370.                           if this1^.AreaConf > 0 then
  371.                             begin
  372.                               found := True;
  373.                               WriteLn(Com, ' ', this1^.AreaConf, ' ', this1^.AreaName
  374.                                 , '  ', this1^.AreaDesc);
  375.                             end;
  376.                           this1 := this1^.next;
  377.                         end;
  378.                       if not found then
  379.                         WriteLn(Com, 'None.');
  380.                       WriteLn(Com);
  381.                       found := False;
  382.                       WriteLn(Com, 'File Conferences:');
  383.                       This := SectBase;
  384.                       while This <> nil do
  385.                         begin
  386.                           if This^.SectConf > 0 then
  387.                             begin
  388.                               found := True;
  389.                               WriteLn(Com, ' ', This^.SectConf, ' ', This^.SectName,
  390.                                 '  ', This^.SectDesc);
  391.                             end;
  392.                           This := This^.next;
  393.                         end;
  394.                       if not found then
  395.                         WriteLn(Com, 'None.');
  396.                       WriteLn(Com);
  397.                     end;
  398.                   if num < 13 then
  399.                     change_user_params_A(num, temp_user_rec);
  400.                   if num > 12 then
  401.                     change_user_params_B(num, temp_user_rec);
  402.                 end;
  403.             until (num = 0) or (num = 99);
  404.             if num <> 0 then
  405.               begin
  406.                 if user_num = user_loc then
  407.                   begin
  408.                     if not remote_copy then
  409.                       if ask('Record new permanent record', 'Y') then
  410.                         begin
  411.                           PutRec(DatF, user_num, temp_user_rec);
  412.                           WriteLn(Com, 'Recording updated user record.');
  413.                         end;
  414.                     user_rec := temp_user_rec;
  415.                   end
  416.                 else
  417.                   begin
  418.                     PutRec(DatF, user_num, temp_user_rec);
  419.                     WriteLn(Com, 'Recording updated user record.');
  420.                   end;
  421.               end;
  422.           end
  423.         else if (credits > 0) and (user_num > 0) then
  424.           begin
  425.             temp_user_rec.upload := temp_user_rec.upload+credits;
  426.             if user_num = user_loc then
  427.               begin
  428.                 if not remote_copy then
  429.                   begin
  430.                     WriteLn(Com, 'Recording updated user record.');
  431.                     PutRec(DatF, user_num, temp_user_rec);
  432.                   end;
  433.                 user_rec := temp_user_rec;
  434.               end
  435.             else
  436.               begin
  437.                 WriteLn(Com, 'Recording updated user record.');
  438.                 PutRec(DatF, user_num, temp_user_rec);
  439.               end;
  440.           end;
  441.       end
  442.     else
  443.       WriteLn(Com, 'Name not found.')
  444.   end;
  445.   
  446. end.                              { of EDITUSR1.PAS}
  447. 
  448.